COMMENT ⊗   VALID 00018 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00005 00002	BEGIN "PREDICTOR"
 00006 00003	α DEFINITIONS, MACROS
 00008 00004	α VARIABLE DECLARATIONS
 00009 00005	α FUNCTION DECLARATIONS
 00013 00006	α	PRINTNAME, CVLB, CROSS, DOT, HOMO_XFRM
 00015 00007	α	DISKIN
 00018 00008	α	DISKOUT
 00020 00009	α	CBFEV
 00023 00010	α	PINIT
 00026 00011	α	INITCAM
 00027 00012	α	SETCAM
 00029 00013	α	INST_INIT
 00033 00014	α	COPYB
 00036 00015	α	HECALL
 00038 00016	α	DPYFRAME,DPYSTAT,DPYL,DISPLAY
 00040 00017	α	HIDEN,PREDICT
 00042 00018	α	***	START OF EXECUTION	***
 00044 ENDMK
⊗;
BEGIN "PREDICTOR"

REQUIRE		500			NEW_ITEMS;
REQUIRE					PNAMES;
REQUIRE		"PREAMB.SAI[SYS,HE]"	SOURCE_FILE;
REQUIRE		"PREDIC.AUX[SYS,HE]"	SOURCE_FILE;
REQUIRE		"SAITRG[SYS,BGB]"	SOURCE_FILE;
REQUIRE		"DPYIII.AUX[H,RPO]"	SOURCE_FILE;
REQUIRE		"PRED0.SAI[SYS,HE]"	LOAD_MODULE;

α DEFINITIONS, MACROS;

DEFINE	INCREM(X)=<X←X+1>,
	DECREM(X)=<X←X-1>,
	#ALBODY=<6>,
	ITG=<INTEGER>,
	mm=<39.36@-3>,

	APOG=<11>,
	BPOG=<12>,
	T1POG=<13>,
	T2POG=<14>,
	SPOG=<15>,
XSUBR=<EXTERNAL SIMPLE PROCEDURE>,
XISUBR=<EXTERNAL INTEGER SIMPLE PROCEDURE>,
XRSUBR=<EXTERNAL REAL SIMPLE PROCEDURE>,
XSSUBR=<EXTERNAL STRING SIMPLE PROCEDURE>,

SUBR=<SIMPLE PROCEDURE>,
ISUBR=<INTEGER SIMPLE PROCEDURE>,
RSUBR=<REAL SIMPLE PROCEDURE>,
SSUBR=<STRING SIMPLE PROCEDURE>,

#PDX=<4>,	#PDY=<5>,	#FOCAL=<6>,
#LDX=<1>,	#LDY=<2>,	#LDZ=<3>,
#XSCALE=<7>,	#YSCALE=<8>,	#ZSCALE=<9>;

α ...#PROTO IS THE INITIAL PROTOTYPE WPTR,
  ...#INST IS THE INITIAL INSTANCE WPTR;
DEFINE	#PROTO=<0>,#INST=<10>;

α RING POSITION NUMBERS; DEFINE

#QRING = <-1>,
#LDX = <1>,	#XL=<1>,
#LDY = <2>,	#XH=<2>,
#LDZ = <3>,	#YL=<3>,
#PDX = <4>,	#YH=<4>,
#PDY = <5>,
#FOCAL = <6>,	#ALBODY=<6>,
#OX = <5>,
#OY = <6>,
#DX = <7>,	#MAGX = <7>,
#DY = <8>,	#MAGY = <8>,
#CAMERA =<-4>,
#LOCOR = <-3>,
#XSCALE = <7>,
#YSCALE = <8>,
#ZSCALE = <9>,
#SOX = <-2>,
#SOY = <-1>;

α VARIABLE DECLARATIONS;

α LOCALS;
ITEM BGB;
BOOLEAN IFLAG;
SAFE REAL ARRAY SIZE7[1:7],LOCARY[-3:8];
ITEMVAR PROTO;
INTEGER MESS1,LOCPTR;

α INTERNALS;
INTERNAL INTEGER
	WPTR,PWORLD,
	LDX,LDY,LDZ,
	VERNX,VERNY,
	CAMERA,SWINDO,OWINDO,IIIDPY,LOC,
	SXL,SXH,SYL,SYH,SCX,SCY,SDX,SDY,
	DXL,DXH,DYL,DYH,DCX,DCY,DDX,DDY;

INTERNAL REAL
	PDX,PDY,FOCAL,
	DA,SA,
	OXL,OXH,OYL,OYH,OX,OY,MAGX,MAGY,SOX,SOY;

INTERNAL SAFE INTEGER ARRAY
	ENTITY	[1:50],
	PART#	[1:50],
	COPAR#	[1:50];

INTERNAL SAFE STRING ARRAY
	NAME	[1:50];
INTERNAL SAFE INTEGER ARRAY DPYAA[1:200];

α EXTERNALS;
EXTERNAL INTEGER WORLD;

α FUNCTION DECLARATIONS;

α RING OPERATIONS;
XSUBR	RINGIN(ITG E,Q,N);
XSUBR	RINGO(ITG E,N);

α DYNAMIC FREE STORAGE;
XISUBR	GETBLK(ITG SIZE);
XSUBR	RELBLK(ITG ADDR);

α MNEMONICS;
ISUBR	CAR(ITG Q);	START_CODE HLRZ 1,@Q END;
ISUBR	CDR(ITG Q);	START_CODE HRRZ 1,@Q END;
SUBR	DAC(ITG N,Q);	START_CODE MOVE N; MOVEM @Q END;
SUBR	DACR(REAL X;ITG Q);	START_CODE MOVE X;MOVEM @Q END;
SUBR	DAP(ITG N,Q);	START_CODE MOVE N;HRRM @Q END;
SUBR	DIP(ITG N,Q);	START_CODE MOVE N;HRLM @Q END;
ISUBR	LAC(ITG Q);	START_CODE MOVE 1,@Q END;
RSUBR	LACR(ITG Q);	START_CODE MOVE 1,@Q END;

α ENTITY TYPES;
BSUBR	BTYPE(ITG X);	RETURN( (CAR(X) LAND 1) ≠ 0) ;

α BFEV MAKE & KILL OPERATIONS;
XISUBR	MKB(ITG W);
XISUBR	MKF(ITG W);
XISUBR	MKE(ITG W);
XISUBR	MKV(ITG W);

α FETCH OPERATIONS;
XISUBR	COPART	(ITG X);
XISUBR	ECNT	(ITG X);
XISUBR	FCNT	(ITG X);
XISUBR	LOCOR	(ITG X);
XISUBR	NBODY	(ITG X);
XISUBR	NCNT	(ITG X);
XISUBR	NCW	(ITG X);
XISUBR	NCCW	(ITG X);
XISUBR	NFACE	(ITG X);
XISUBR	NED	(ITG X);
XISUBR	NVT	(ITG X);
XISUBR	PART	(ITG X);
XISUBR	PCW	(ITG X);
XISUBR	PCCW	(ITG X);
XISUBR	PED	(ITG X);
XISUBR	PFACE	(ITG X);
XISUBR	PNAME	(ITG X);
XISUBR	PVT	(ITG X);
XISUBR	SERIAL	(ITG X);
XISUBR	VCNT	(ITG X);
XISUBR	X1DC	(ITG E);
XISUBR	Y1DC	(ITG E);
XISUBR	X2DC	(ITG E);
XISUBR	Y2DC	(ITG E);


α STORE LINK INTO NODE OPERATIONS;
XISUBR	NCW..	(ITG Q,E);
XISUBR	NCCW..	(ITG Q,E);
XISUBR	NCNT.	(ITG V,Q);
XISUBR	NED.	(ITG Q,E);
XISUBR	NFACE.	(ITG Q,E);
XISUBR	NVT.	(ITG Q,E);
XISUBR	PCW..	(ITG Q,E);
XISUBR	PCCW..	(ITG Q,E);
XISUBR	PED.	(ITG E,Q);
XISUBR	PFACE.	(ITG Q,E);
XISUBR	PNAME.	(ITG W,B);
XISUBR	PVT.	(ITG Q,E);

α WING MAKE LINK OPERATION;
XISUBR	NCCW.	(ITG Q,E);
XISUBR	NCW.	(ITG Q,E);
XISUBR	PCCW.	(ITG Q,E);
XISUBR	PCW.	(ITG Q,E);

α FETCH DATA FROM NODE;
XRSUBR XWC(ITG E);
XRSUBR YWC(ITG E);
XRSUBR ZWC(ITG E);
XRSUBR XPP(ITG E);
XRSUBR YPP(ITG E);
XRSUBR ZPP(ITG E);

α EXTERNAL PROCEDURES;
EXTERNAL PROCEDURE OCCULT;

α IMAGE SYNTHESIS OPERATIONS;
XISUBR	MKLOCOR;
XSUBR	PROJECTOR(ITG CAMERA,ALBODY);
XSUBR	EMARKALL(ITG ALBODY);
XSUBR	FMARK(ITG ALBODY);
XSUBR	EMARK(ITG ALBODY);
XISUBR	CLIPER(ITG WINDOW,ALBODY);
XSUBR	KLJOTS;
XSUBR	KLJUTS;
XSUBR	KLTEMP;
α	PRINTNAME, CVLB, CROSS, DOT, HOMO_XFRM;

SSUBR PRINTNAME(ITEMVAR X);
BEGIN "PNAME"
STRING NAME;
INTEGER I;
NAME←CVIS(X,I);
IF I
THEN IF CVN(X)>1024
     THEN NAME←"G"&CVOS(CVN(X))
     ELSE NAME←"L"&CVOS(CVN(X));
RETURN(NAME);
END "PNAME";

ISUBR CVLB(ITEMVAR X);
BEGIN "CVLB"
INTEGER ITEMVAR Y;
∀ Y|BGB⊗X≡Y DO DONE;
RETURN(∂(Y));
END "CVLB";

SUBR CROSS(REFERENCE SAFE REAL ARRAY A,B,CP);
BEGIN "CROSS"
	CP[1]←A[2]*B[3]-A[3]*B[2];
	CP[2]←A[3]*B[1]-A[1]*B[3];
	CP[3]←A[1]*B[2]-A[2]*B[1];
	END "CROSS";

RSUBR DOT(SAFE REAL ARRAY V1,V2);
BEGIN "DOT"
	REAL DP;INTEGER I;
	DP←0.0;
	FOR I←1 THRU 4 DO DP←DP+V1[I]*V2[I];
	RETURN(DP);
	END "DOT";

PROCEDURE HOMO_XFRM(SAFE REAL ARRAY P,T);
BEGIN "HOMOXFRM"
SAFE REAL ARRAY TEMP[1:4];
INTEGER I,J;
FOR I←1 STEP 1 UNTIL 4 DO
BEGIN "H1"
	TEMP[I]←0.0;
	FOR J←1 STEP 1 UNTIL 4 DO
		TEMP[I]←TEMP[I]+T[I,J]*P[J];
	END "H1";
FOR J←1 STEP 1 UNTIL 4 DO P[J]←TEMP[J]/TEMP[4];
END "HOMOXFRM";
α	DISKIN;

PROCEDURE DISKIN;
BEGIN "DISKIN"
SAFE REAL ARRAY ITEMVAR GI,GC;
ITEMVAR GP;
SAFE REAL ARRAY XF[1:10,1:3],FOURBY4[1:4,1:4];
STRING FILENAME,ANS,STR,PNAME;
INTEGER I,J,K,BREAK,EOF,FLAG,BODYNUM;
DEFINE	INFILE=<1>, LYNE=<1>, PARE=<2>, ID=<3>;
DEFINE	NUMBER=<BODYNUM>, OF=<←>, INSTANCES=<INTIN(INFILE);>,
	GETPNAME=<DO ⊂  NEXTLINE TOKEN ⊃ UNTIL LENGTH(PNAME);>,
	NEXTLINE=<STR←INPUT(INFILE,LYNE);>,
	TOKEN=<	PNAME←SCAN(STR,PARE,BREAK);
		PNAME←SCAN(STR,ID,BREAK);>,
	PROTOTYPEi=<NEXTLINE
		FOR I←1 STEP 1 UNTIL BODYNUM DO
		BEGIN "ILOOP"
	GETPNAME
	GP←CVSI(PNAME,FLAG);
	IF FLAG
	THEN ⊂ TYPE "CVSI LOSSAGE" EOM; CALL(0,"EXIT"); ⊃; >,
	BODYi=<GI←$ NEW(FOURBY4);
		$ MAKE INSTANCE⊗GP≡GI;>,
	TRANSFORMi=< FOR J←1 STEP 1 UNTIL 4 DO
		FOR K←1 STEP 1 UNTIL 4 DO
		$ ∂(GI)[J,K]←REALIN(INFILE);
		END "ILOOP";	>,
	CAMERA=<GC←$ NEW(XF);
		$ MAKE XFORM⊗SCENE≡GC;>,
	TRANSFORM=< FOR J←1 STEP 1 UNTIL 10 DO
		FOR K←1 STEP 1 UNTIL 3 DO
		$ ∂(GC)[J,K]←REALIN(INFILE);>;


SETBREAK(LYNE,'15,'12,"INS");
SETBREAK(PARE,"CRWG","","INR");
SETBREAK(ID," "&TAB,"","INR");
OPEN(INFILE,"DSK",0,2,0,120,BREAK,EOF);
DO ⊂	TYPE "FILE NAME (.REC assumed) = " EOS;
	FILENAME←INCHWL&".REC";
	LOOKUP(INFILE,FILENAME,FLAG);
	IF FLAG
	THEN TYPE "FILE "&FILENAME&" NOT FOUND!" EOM;
	⊃ UNTIL ¬FLAG;

α FILE FORMAT;

NUMBER OF INSTANCES

PROTOTYPEi	BODYi
TRANSFORMi

CAMERA TRANSFORM

α EOF.;

RELEASE(INFILE);
END "DISKIN";

α	DISKOUT;

INTERNAL PROCEDURE DISKOUT;
BEGIN "DISKOUT"
SAFE REAL ARRAY ITEMVAR GP;
ITEMVAR GL;
SET LSET;
INTEGER EOF,BREAK,FLAG,LINENUM;
STRING ANS,FILENAME;
DEFINE	PRINT =<OUT(OUTFILE,>,
	SEPARATE=<OUT(OUTFILE,↓&↓&↓&↓);>,
	OUTFILE=<1>,
	!=<&↓);>, CRLF=<OUT(OUTFILE,↓);>;

TYPE "WOULD YOU LIKE AN OUTPUT FILE?" EOM;
IF ANS←INCHWL="Y" ∨ ans="y"
THEN BEGIN "OUT"
	OPEN(OUTFILE,"DSK",0,0,2,120,BREAK,EOF);
	DO ⊂
	TYPE "FILE NAME (.PRE ASSUMED) = " EOS;
	FILENAME←INCHWL&".PRE";
	ENTER(OUTFILE,FILENAME,FLAG);
	IF FLAG
	THEN TYPE "ENTER FAILED !" EOM;
	⊃ UNTIL ¬FLAG;

LSET←($ VISIBLE⊗SCENE);
LINENUM←LENGTH(LSET);
PRINT "RESULTS OF PREDICTOR" !
SEPARATE
PRINT "THERE ARE "&CVS(LINENUM)&" VISIBLE LINES." !
SEPARATE
∀ GL|$ VISIBLE⊗SCENE≡GL DO
BEGIN "V LINE"
	PRINT TAB&"LINE: "&PRINTNAME(GL) !
	∀ GP|$ ENDPT⊗GL≡GP DO
	PRINT TAB&TAB&"ENDPT: "&PRINTNAME(GP)&TAB&
		CVG($ ∂(GP)[1])&CVG($ ∂(GP)[2]) !
	CRLF
	END "V LINE";
SEPARATE
PRINT "EOF." !

RELEASE(OUTFILE);

END "OUT";
END "DISKOUT";

α	CBFEV;

PROCEDURE CBFEV(INTEGER B;ITEMVAR P);
BEGIN "CBFEV"
INTEGER		I,Q,E#,PF#,NF#,
		PV#,NV#,PCCW#,PCW#,NCCW#,NCW#;
ITEMVAR		E,NF,PCWE,PCCWE,NCWE,NCCWE;
SAFE REAL ARRAY ITEMVAR
		PV,NV,OV,PF;
SET		FSET,VSET,PFSET,NFSET;
SAFE REAL ARRAY
		VE,VPCWE,CP[1:4];

∀ E|$ EDGE⊗P≡E DO
⊂ "EDGE"
	E#←CVLB(E);
	FSET←$ BOUNDARY`E;
	PF←LOP(FSET);	PF#←CVLB(PF);
	NF←COP(FSET);	NF#←CVLB(NF);
	VSET←$ ENDPT⊗E;
	PV←LOP(VSET);	PV#←CVLB(PV);
	NV←COP(VSET);	NV#←CVLB(NV);
	PFSET←$ BOUNDARY⊗PF-{E};
	NFSET←$ BOUNDARY⊗NF-{E};
	PCWE←COP(($ ENDPT`PV)∩PFSET);	PCW#←CVLB(PCWE);
	PCCWE←COP(($ ENDPT`NV)∩PFSET);	PCCW#←CVLB(PCCWE);
	NCWE←COP(($ ENDPT`NV)∩NFSET);	NCW#←CVLB(NCWE);
	NCCWE←COP(($ ENDPT`PV)∩NFSET);	NCCW#←CVLB(NCCWE);

	FOR I←1 THRU 4 DO VE[I]←$ ∂(PV)[I]-$ ∂(NV)[I];
	OV←COP(($ ENDPT⊗PCWE)-{PV});
	FOR I←1 THRU 4 DO VPCWE[I]←$ ∂(OV)[I]-$ ∂(PV)[I];

	CROSS(VE,VPCWE,CP);
	IF DOT(CP,$ ∂(PF)) > 0
	THEN ⊂	PF↔NF;		PF#↔NF#;
		NCCWE↔PCWE;	NCCW#↔PCW#;
		PCCWE↔NCWE;	PCCW#↔NCW# ⊃;

	PVT.(PV#,E#);
	NVT.(NV#,E#);
	PFACE.(PF#,E#);
	NFACE.(NF#,E#);
	PCW..(PCW#,E#);
	PCCW..(PCCW#,E#);
	NCW..(NCW#,E#);
	NCCW..(NCCW#,E#);

	Q←PFACE(E#);
	PED.(E#,Q);		NCNT.(NCNT(Q)+1,Q);
	Q←NFACE(E#);
	PED.(E#,Q);		NCNT.(NCNT(Q)+1,Q);

	PED.(E#,NV#);
	PED.(E#,PV#) ⊃ "EDGE";

	END "CBFEV";

α	PINIT;

SUBR PINIT;
BEGIN "PINIT"
ITEMVAR F,E,PROTO;
SAFE REAL ARRAY ITEMVAR V;
INTEGER Q,PB,CNT,I;

TYPE "PROTOTYPE INITIALIZATION IN PROGRESS" EOM;

α prototype world initialization;

WPTR←#PROTO;
WORLD←GETBLK(5+10)+4;
α RINGO(WORLD,#ALBODY) ... REPLACE WITH DIP AND DAP:;
α RINGO(WORLD,#CAMERA) ... REPLACE WITH DIP AND DAP:;
DIP(WORLD,WORLD+#ALBODY);
DAP(WORLD,WORLD+#ALBODY);
DIP(WORLD,WORLD+#CAMERA);
DAP(WORLD,WORLD+#CAMERA);
LOC←MKLOCOR;
DAP(LOC,WORLD-2);
DAP(-WORLD,WORLD-3);
DIP(-WORLD,WORLD-3);

α create a BGB data structure for prototypes in the upper segment;

α REMOVE THE NEW PROTOTYPES FROM PROTOTYPES...;

PROTOTYPES←PROTOTYPES - {SLAB,WEDGE,BOX,LBEAM,RHOMBOID};

∀ PROTO|PROTOεPROTOTYPES DO
BEGIN	"PI"
	TYPE TAB&"INITIALIZE PROTOTYPE "&PRINTNAME(PROTO) EOM;
	PB←MKB(WORLD);
	MAKE BGB⊗PROTO≡NEW(PB);
α	RINGIN(PB,WORLD,#ALBODY)...LET THEM BE INVISIBLE ! ;
	INCREM(WPTR); α ...REDUNDENT, BUT WHY NOT;
	ENTITY[WPTR]←PB;
	PNAME.(WPTR,PB);
	NAME[WPTR]←PRINTNAME(PROTO);
	CNT←0;
	∀ F|$ FACE⊗PROTO≡F DO
	⊂ Q←MKF(PB);INCREM(CNT); MAKE BGB⊗F≡NEW(Q) ⊃;
	CNT←0;
	∀ E|$ EDGE⊗PROTO≡E DO
	⊂ Q←MKE(PB);INCREM(CNT); MAKE BGB⊗E≡NEW(Q) ⊃;
	CNT←0;
	∀ V|$ VERTEX⊗PROTO≡V DO
	⊂ Q←MKV(PB); FOR I←1 THRU 3 DO DACR($ ∂(V)[I],Q-4+I);
	  INCREM(CNT); MAKE BGB⊗V≡NEW(Q) ⊃;
	CBFEV(PB,PROTO);
α	PART#[PNAME(PB)]←-PNAME(-PART(PB));
α	COPAR#[PNAME(PB)]←-PNAME(-COPART(PB));
	END "PI";

END "PINIT";

α	INITCAM;

SUBR INITCAM;
BEGIN "INITCAM"
	DACR(PDX,CAMERA+#PDX);
	DACR(PDY,CAMERA+#PDY);
	DACR(FOCAL,CAMERA+#FOCAL);

	DAC(LDX,CAMERA+#LDX);
	DAC(LDY,CAMERA+#LDY);
	DAC(LDZ,CAMERA+#LDZ);

	DACR(-FOCAL*LDX/PDX,CAMERA+#XSCALE);
	DACR(-FOCAL*LDY/PDY,CAMERA+#YSCALE);
	DACR( FOCAL*LDZ    ,CAMERA+#ZSCALE);
END "INITCAM";

α	SETCAM;

SUBR SETCAM;
BEGIN	"SETCAM"
	ITG CAMLOC;
	REAL X,Y,Z,PAN,TILT,F;
	REAL CP,SP,CT,ST,TMP;
	REAL IXX,IYY,IZZ,JXX,JYY,JZZ,KXX,KYY,KZZ;
	SAFE REAL ARRAY ITEMVAR XRA;

∀ XRA|$ XFORM⊗SCENE≡XRA DO DONE;
X←$ ∂(XRA)[4,1];
Y←$ ∂(XRA)[4,2];
Z←$ ∂(XRA)[4,3];
PAN←$ ∂(XRA)[9,1];
TILT←$ ∂(XRA)[9,2];
F ← IF ($ ∂(XRA)[10,2]=1) THEN 25.0 ELSE 50.0;
	FOCAL ← F *  mm;
	CAMLOC ← LOCOR(CAMERA);
	DACR(X,CAMLOC-3);
	DACR(Y,CAMLOC-2);
	DACR(Z,CAMLOC-1);
	IXX ← JYY ← KZZ ← 1;
	IYY ← IZZ ← 0;
	JXX ← JZZ ← 0;
	KXX ← KYY ← 0;
α PAN THE CAMERA ABOUT WORLD VERTICAL;
	PAN ← PAN + π/2;
	TILT ← π/2 - TILT;
	CP	←	COS(PAN);
	SP	←	SIN(PAN);
	TMP ← CP*IXX - SP*IYY; IYY ← CP*IYY + SP*IXX; IXX ← TMP;
	TMP ← CP*JXX - SP*JYY; JYY ← CP*JYY + SP*JXX; JXX ← TMP;
α TILT THE CAMERA ABOUT CAMERA HORIZONTAL;
	CT	←	COS(TILT);
	ST	←	-SIN(TILT);
	TMP ← CT*JXX - ST*KXX; KXX ← CT*KXX + ST*JXX; JXX ← TMP;
	TMP ← CT*JYY - ST*KYY; KYY ← CT*KYY + ST*JYY; JYY ← TMP;
	TMP ← CT*JZZ - ST*KZZ; KZZ ← CT*KZZ + ST*JZZ; JZZ ← TMP;

	DACR(IXX,CAMLOC+0); DACR(IYY,CAMLOC+1); DACR(IZZ,CAMLOC+2);
	DACR(JXX,CAMLOC+3); DACR(JYY,CAMLOC+4); DACR(JZZ,CAMLOC+5);
	DACR(KXX,CAMLOC+6); DACR(KYY,CAMLOC+7); DACR(KZZ,CAMLOC+8);
	INITCAM;
END	"SETCAM";
α	INST_INIT;

SUBR INST_INIT;
BEGIN "IINIT"

IFLAG←TRUE;
α ???;
START_CODE
	MOVE LOCARY;
	ADDI 3;
	MOVEM LOCPTR;
	END;

α AD HOC CAMERA RING INITIALIZATION;
TYPE "CAMERA RING INIT" EOM;
	CAMERA←GETBLK(5+10) + 4;
	LOC←MKLOCOR;
	DACR(16.0, LOC-1);
	RINGIN(CAMERA,WORLD,#CAMERA);
	RINGO(CAMERA,#QRING);
	RINGO(CAMERA,#LOCOR);
	DAP(LOC,CAMERA-2);
	RINGIN(LOC,CAMERA,#LOCOR);
α THE SIZE OF THE CAMERA:
WIDE - 345 PIXELS	2*12.7 mm
HIGH - 256 ROWS		2*9.5 mm
OF WHICH THE FOLLOWING AMOUNT ARE READ BY THE CAMERA:
WIDE -	316 PIXELS
HIGH -	240 ROWS
NOTE: PDX,PDY ARE THE PHYSICAL SIZE OF LDX,LDY - THEY
ARE THE SAME THING IN TWO DIFFERENT UNITS OF MEASURE;
	LDX←158;
	LDY←120;
	LDZ←100000;

	PDX ← 12.7*mm*LDX/345;
	PDY ← 9.5*mm*LDY/256;
	FOCAL ← 25.0*mm;

	INITCAM;

α SOURCE WINDOW;
TYPE "SOURCE WINDOW INIT" EOM;
	SWINDO←GETBLK(2+10)+1; RINGIN(SWINDO,CAMERA,#QRING);
	SXL←-LDX; SXH←LDX; SCX←0;
	SYL←-LDY; SYH←LDY; SCY←0;
	SDX←SXH-SXL; SDY←SYH-SYL;
	SA←SDX/SDY;

	DAC(SXL,SWINDO+#XL); DAC(SXH,SWINDO+#XH);
	DAC(SYL,SWINDO+#YL); DAC(SYH,SWINDO+#YH);
	DAC(SCX,SWINDO+#OX);
	DAC(SCY,SWINDO+#OY);
	DAC(SDX,SWINDO+#DX);
	DAC(SDX,SWINDO+#DX);
	DAC(SDY,SWINDO+#DY);

α III DISPLAY WINDOW FRAME;
TYPE "III DISPLAY WINDOW INIT" EOM;
	IIIDPY←GETBLK(4+10)+3;
	DDX←DDY←500; DA←1;
	DCX←250; DCY←-250;
	DXL←0; DXH←DXL+DDX;
	DYL←-500; DYH←DYL+DDY;
	DAC(DDX,IIIDPY+#DX);
	DAC(DDY,IIIDPY+#DY);
	DACR(DXL,IIIDPY+#XL); DACR(DXH,IIIDPY+#XH);
	DACR(DYL,IIIDPY+#YL); DACR(DYH,IIIDPY+#YH);

α OBJECT WINDOW;
TYPE "OBJECT WINDOW INIT" EOM;
	OWINDO←GETBLK(3+10)+2;
	DAP(OWINDO,SWINDO);
	DAP(IIIDPY,OWINDO);
α CRAM SWINDO INTO DPY FRAME OWINDO;
TYPE "CRAM" EOM;
	MAGY←MAGX←(IF SA>DA THEN DDX/SDX ELSE DDY/SDY);
	DACR(MAGX,OWINDO+#MAGX);
	DACR(MAGY,OWINDO+#MAGY);
TYPE "CROP" EOM;
	OXL←DXL;
	OXH←DXL+MAGX*SDX;
	OYL←DYL;
	OYH←DYL+MAGY*SDY;
	DACR(OXL,OWINDO+#XL); DACR(OXH,OWINDO+#XH);
	DACR(OYL,OWINDO+#YL); DACR(OYH,OWINDO+#YH);
	DACR(SOX←DCX,OWINDO+#SOX);
	DACR(SOY←DCY,OWINDO+#SOY);
α SHOW THE INITIAL DISPLAY;
TYPE "SHOW THE INITIAL DISPLAY" EOM;
	VERNX←-12; VERNY←-9;
	START_CODE PPIOT 2,-250; PPIOT 3,'3003; ⊃;

TYPE "DONE INST_INIT" EOM;
END "IINIT";
α	COPYB
copy the BGB data structure of prototype BGB body PB
for an instance and return the instance body integer;

INTEGER PROCEDURE COPYB(INTEGER PB;SAFE REAL ARRAY ITEMVAR INST);
BEGIN "COPYB"
INTEGER I,IB,#F,#E,#V,#IF,#IE,#IV,#FS,#ES,#VS,E,PF,NF,PV,NV;
SAFE REAL ARRAY
	FACES[1:FCNT(PB)],
	EDGES[1:ECNT(PB)],
	VERTS[1:VCNT(PB)];

α ...ATTACH THE INSTANCE AS A PART OF THE PROTOTYPE;
	IB←MKB(PB);
	MAKE BGB⊗INST≡NEW(IB);
	RINGIN(IB,WORLD,#ALBODY);
	INCREM(WPTR);
	ENTITY[WPTR]←IB;
α ...∀ F,E,V OF THE PROTOTYPE MKF,MKE,MKV FOR THE INSTANCE;
	#F←PB;
	#E←PB;
	#V←PB;
WHILE TRUE DO
⊂ "E LOOP"
 #E←PED(#E); IF BTYPE(#E) THEN DONE;
 #IE←MKE(IB); EDGES[SERIAL(#E)]←#IE; ⊃ "E LOOP";
WHILE TRUE DO
⊂ "F LOOP"
 #F←PFACE(#F); IF BTYPE(#F) THEN DONE;
 #IF←MKF(IB); FACES[SERIAL(#F)]←#IF;
 PED.	(EDGES[SERIAL(PED(#F))],	#IF); ⊃ "F LOOP";
WHILE TRUE DO
⊂ "V LOOP"
 #V←PVT(#V); IF BTYPE(#V) THEN DONE;
 #IV←MKV(IB); FOR I←1 THRU 3 DO DACR(LACR(#V-I),#IV-I);
 VERTS[SERIAL(#V)]←#IV;
 PED.	(EDGES[SERIAL(PED(#V))],	#IV); ⊃ "V LOOP";

α ...NOW PUT IN THE WINGS;
	#E←(PB);
WHILE TRUE DO
⊂ "COPY WINGS"
#E←PED(#E); IF BTYPE(#E) THEN DONE;
E←EDGES[SERIAL(#E)];
NFACE.	(FACES[SERIAL(NFACE(#E))],	E);
PFACE.	(FACES[SERIAL(PFACE(#E))],	E);
NVT.	(VERTS[SERIAL(NVT(#E))],	E);
PVT.	(VERTS[SERIAL(PVT(#E))],	E);
NCW..	(EDGES[SERIAL(NCW(#E))],	E);
PCW..	(EDGES[SERIAL(PCW(#E))],	E);
NCCW..	(EDGES[SERIAL(NCCW(#E))],	E);
PCCW..	(EDGES[SERIAL(PCCW(#E))],	E) ⊃ "COPY WINGS";
RETURN(IB);

END "COPYB";

α	HECALL;

PROCEDURE HECALL;
BEGIN "HECALL"
SAFE REAL ARRAY ITEMVAR INST,B,GI,PROTO;
INTEGER I,#IB,#F,#V,#E;
SAFE REAL ARRAY T[1:4];
DEFINE	X=<T[1]>,Y=<T[2]>,Z=<T[3]>,W=<T[4]>;

TYPE "HECALL - ENTERED" EOM;

α first initialize an instance world, including camera;
IF ¬IFLAG
THEN INST_INIT;

α now for each instance, make a copy of the BGB prototype
data structure, with a LOCOR and the vertices updated to the
instance position;

WPTR←#INST;
I←0;
∀ GI,PROTO|$ INSTANCE⊗PROTO≡GI DO
BEGIN "GETBODY"
	I←I+1;
α	#B←ENTITY[I];
	#IB←COPYB(CVLB(PROTO),GI);
α ∀ V| $ BV⊗GI≡V DO...;
	#V←#IB;
WHILE TRUE DO
BEGIN "BODY LOOP"
	#V←PVT(#V);
	IF BTYPE(#V) THEN DONE;

	X←XWC(#V);
	Y←YWC(#V);
	Z←ZWC(#V);
	W←1.0;
α TYPE "CALL TO HOMO_XFRM" EOM;
	HOMO_XFRM(T,$ ∂(GI));
α TYPE "AFTER TO HOMO_XFRM" EOM;
	DACR(X,#V-3);
	DACR(Y,#V-2);
	DACR(Z,#V-1);
	END "BODY LOOP";
	END "GETBODY";
TYPE "DONE" EOM;
END "HECALL";
α	DPYFRAME,DPYSTAT,DPYL,DISPLAY;

SUBR DPYFRAME(ITG W);
BEGIN "DFRAME"
ITG XL,XH,YL,YH;
XL←LACR(W+#XL);	XH←LACR(W+#XH);
YL←LACR(W+#YL);	YH←LACR(W+#YH);
AIVECT(XL,YL); AVECT(XH,YL);
AVECT(XH,YH); AVECT(XL,YH); AVECT(XL,YL);
END "DFRAME";

SUBR DPYSTAT;
⊂ "DPYSTAT" DPYSET(DPYAA);DPYBIG(2);
AIVECT(LACR(IIIDPY+#XL)+5,LACR(IIIDPY+#YH)-25);
DPYSST("PREDICTOR"); DPYFRAME(IIIDPY); DPYFRAME(OWINDO);
DPYOUT(SPOG) ⊃ "DPYSTAT";

PROCEDURE DPYL(ITEMVAR L);
BEGIN "DPYL"
SAFE REAL ARRAY ITEMVAR VA,VB;
SET VSET;
VSET←$ ENDPT⊗L;
VA←LOP(VSET);
VB←COP(VSET);
AIVECT($ ∂(VA)[1]*MAGX+DXL,$ ∂(VA)[2]*MAGY+DYL);
AVECT($ ∂(VB)[1]*MAGX+DXL,$ ∂(VB)[2]*MAGY+DYL);
END "DPYL";

SUBR DISPLAY(ITEMVAR S);
BEGIN "DISPLAY"
ITEMVAR E;

DPYSET(DPYAA);
∀ E|$ VISIBLE⊗S≡E DO DPYL(E);
DPYOUT(APOG);

END "DISPLAY";

α	HIDEN,PREDICT;

SUBR HIDEN;
BEGIN "HIDEN"
SAFE REAL ARRAY ITEMVAR GPA,GPB;
REAL ITEMVAR GL;
INTEGER ELIST,E0,PVNUM,NVNUM,FLAG;
α ...CAMERA,SWINDO,OWINDO,DPY ALL CONTAIN THE ORIGINAL GETBLK PTRS;
	PROJECTOR(CAMERA,WORLD);
IF ¬RUN
THEN ⊂	TYPE "TEST?" EOM;
	IF INCHRW="Y"
	THEN EMARKALL(WORLD) ⊃;
FMARK(WORLD);
EMARK(WORLD);
OCCULT;
KLJOTS;

E0←ELIST←CLIPER(OWINDO,WORLD);
ELIST←ELIST LAND '777777;
WHILE ELIST≠0 DO
⊂ "VISIBLE"
	GL←$ NEW(0.0);
	$ MAKE VISIBLE⊗SCENE≡GL;
	PVNUM←PVT(ELIST);
	NVNUM←NVT(ELIST);
	GPA←CVSI(CVS(PVNUM), FLAG);
	IF FLAG
	THEN ⊂ GPA←$ NEW(SIZE7); NEW_PNAME(GPA,CVS(PVNUM)) ⊃;
	GPB←CVSI(CVS(NVNUM), FLAG);
	IF FLAG
	THEN ⊂ GPB←$ NEW(SIZE7); NEW_PNAME(GPB,CVS(NVNUM)) ⊃;
	$ ∂(GPA)[1]←XPP(PVT(ELIST))+LDX;
	$ ∂(GPA)[2]←YPP(PVT(ELIST))+LDY;
	$ ∂(GPB)[1]←XPP(NVT(ELIST))+LDX;
	$ ∂(GPB)[2]←YPP(NVT(ELIST))+LDY;
	$ MAKE ENDPT⊗GL≡GPA;
	$ MAKE ENDPT⊗GL≡GPB;
	ELIST←NBODY(ELIST) ⊃ "VISIBLE";
KLJUTS;
KLTEMP;
END "HIDEN";

MESSAGE PROCEDURE PREDICT;
BEGIN "PREDICT"
"H"	HECALL;
"B"	SETCAM;
	HIDEN;
β	DPYSTAT;
β	DISPLAY(SCENE);
	IF ¬RUN
	THEN BEGIN "DEBUG"
		DISKOUT;
		OUTSTR("PRE RESULTS - WAITING");
		INCHWL;
		END "DEBUG";
	END "PREDICT";

α	***	START OF EXECUTION	***;

IF ¬YES_PRED
THEN PUT_DATA(0,0,"PREDICTOR");
YES_PRED←TRUE;

PINIT;


TYPE "PREDICTOR (PRE) UP AND READY" EOM;

WHILE TRUE DO
IF RUN
THEN BEGIN "LOOP"
	TYPE "PRE - WAITING FOR MESSAGE" EOM;
	MESS1←GET_ENTRY('120,NULL,"PREDICTOR",NULL);
	MESS1←QUEUE('600,MESS1);
	ISSUE(1,"PREDICTOR","RECOGNIZER",MESSAGE CHECK(SCENE));
	END "LOOP"
ELSE BEGIN "TEST"
	IF ¬YES_REC
	THEN DISKIN;
	PREDICT;
	END "TEST";

END "PREDICTOR";

EOF.